Aminet 40/Aminet 40 (2000)(Schatztruhe)[!][Dec 2000].iso/Aminet/misc/emu/ATUtilities.lha/ATUtilities/M2/TURBOSYS.MOD

Modula Implementation | 2000-09-26 | 7.1 KB | 391 lines

(*$S-, $R-, $A-, $T- *)
IMPLEMENTATION MODULE TurboSys;

FROM SYSTEM  IMPORT ADR,ADDRESS,OFS,SEG,ASSEMBLER;
FROM System  IMPORT AX,BX,CX,DX,ES,DI,DS,SI,BP,Trap,XTrap,GetVector,Terminate;
FROM Strings IMPORT Assign;
FROM Storage IMPORT ALLOCATE,DEALLOCATE;
FROM Loader  IMPORT Execute;
FROM InOut   IMPORT WriteString,WriteLn;
FROM Break   IMPORT InstallBreakHandler,UninstallBreakHandler,EnableBreak;

PROCEDURE WriteText(a,x,y : CARDINAL;
                    text  : STRING);
BEGIN
 AX := 00000H;
 BX := a;
 CX := x;
 DX := y;
 ES := text.SEG;
 DI := text.OFS;
 XTrap(interruptVector);
END WriteText;

PROCEDURE Fill(attribut,
               x,y,w,h,
               zeichen   : CARDINAL);
BEGIN
 AX := 00001H;
 BX := attribut;
 CX := x;
 DX := y;
 DS := w;
 SI := h;
 DI := zeichen;
 XTrap(interruptVector);
END Fill;

PROCEDURE SetCursor(x,y : CARDINAL);
BEGIN
 AX := 0002H;
 BX := x;
 CX := y;
 Trap(interruptVector);
END SetCursor;

PROCEDURE RestoreCursor;
BEGIN
 AX := 0003H;
 Trap(interruptVector);
END RestoreCursor;

PROCEDURE CopyVideo2Buffer(buffer  : ADDRESS;
                           x,y,w,h : CARDINAL);
BEGIN
 AX := 0004H;
 BX := x;
 CX := y;
 DX := w;
 DS := h;
 ES := buffer.SEG;
 DI := buffer.OFS;
 XTrap(interruptVector);
END CopyVideo2Buffer;

PROCEDURE CopyBuffer2Video(buffer  : ADDRESS;
                           x,y,w,h : CARDINAL);
BEGIN
 AX := 0005H;
 BX := x;
 CX := y;
 DX := w;
 DS := h;
 ES := buffer.SEG;
 DI := buffer.OFS;
 XTrap(interruptVector);
END CopyBuffer2Video;

PROCEDURE MouseReset;
BEGIN
 AX := 00100H;
 Trap(interruptVector);
END MouseReset;

PROCEDURE MouseOn;
BEGIN
 AX := 00101H;
 Trap(interruptVector);
END MouseOn;

PROCEDURE MouseOff;
BEGIN
 AX := 00102H;
 Trap(interruptVector);
END MouseOff;

PROCEDURE GetMousePosition(VAR x,y : CARDINAL;
                           VAR b   : MouseButtonSet);
BEGIN
 AX := 00103H;
 Trap(interruptVector);
 x := tdos^.mouseX;
 y := tdos^.mouseY;
 b := tdos^.mouseButtons;
END GetMousePosition;

PROCEDURE OpenScreen;
BEGIN
 AX := 00200H;
 Trap(interruptVector);
END OpenScreen;

PROCEDURE CloseScreen;
BEGIN
 AX := 00201H;
 Trap(interruptVector);
END CloseScreen;

PROCEDURE OpenWindow(titel   : ARRAY OF CHAR;
                     x,y,w,h : CARDINAL;
                     flgs    : WindowFlagSet;
                     mw,mh   : CARDINAL) : WindowPtr;
VAR win : WindowPtr;
BEGIN
 ALLOCATE(win,SIZE(Window));
 IF (win=NIL) THEN
  Terminate(0);
 END (* IF *);
 WITH win^ DO
  leftEdge := x;
  topEdge  := y;
  width    := w;
  height   := h;
  flags    := flgs;
  IF (windowSizing IN flgs) THEN
   bufferSize := tdos^.videoSize;
  ELSE
   bufferSize := w*h*2;
  END (* IF *);
  Assign(titel,win^.title);
  ALLOCATE(buffer,bufferSize);
  IF (buffer=NIL) THEN
   Terminate(0);
  END (* IF *);
  minWidth  := mw;
  minHeight := mh;
 END (* WITH *);
 AX := 0202H;
 ES := win.SEG;
 DI := win.OFS;
 XTrap(interruptVector);
 RETURN(win);
END OpenWindow;

PROCEDURE SetAPen(farbe : CARDINAL);
BEGIN
 AX := 0203H;
 BX := farbe;
 Trap(interruptVector);
END SetAPen;

PROCEDURE SetBPen(farbe : CARDINAL);
BEGIN
 AX := 0204H;
 BX := farbe;
 Trap(interruptVector);
END SetBPen;

PROCEDURE Move(x,y : CARDINAL);
BEGIN
 AX := 0205H;
 BX := x;
 CX := y;
 Trap(interruptVector);
END Move;

PROCEDURE Text(text : ARRAY OF CHAR);
VAR adr : ADDRESS;
BEGIN
 adr := ADR(text);
 AX := 0206H;
 ES := adr.SEG;
 DI := adr.OFS;
 XTrap(interruptVector);
END Text;

PROCEDURE ShowMenu(menu : MenuPtr);
BEGIN
 AX := 0207H;
 ES := menu.SEG;
 DI := menu.OFS;
 XTrap(interruptVector);
END ShowMenu;

PROCEDURE SystemManager;
BEGIN
 AX := 02FFH;
 Trap(interruptVector);
END SystemManager;

PROCEDURE ShowHelp(t1,t2 : ARRAY OF CHAR);
VAR a1,a2 : ADDRESS;
BEGIN
 a1 := ADR(t1);
 a2 := ADR(t2);
 AX := 0208H;
 ES := a1.SEG;
 DI := a1.OFS;
 BX := a2.SEG;
 CX := a2.OFS;
 XTrap(interruptVector);
END ShowHelp;

PROCEDURE ShowGadget(gad : GadgetPtr);
BEGIN
 AX := 0209H;
 ES := gad.SEG;
 DI := gad.OFS;
 XTrap(interruptVector);
END ShowGadget;

PROCEDURE MoveWindow(x,y : CARDINAL);
BEGIN
 AX := 020AH;
 BX := x;
 CX := y;
 Trap(interruptVector);
END MoveWindow;

PROCEDURE SizeWindow(w,h : CARDINAL);
BEGIN
 AX := 020BH;
 BX := w;
 CX := h;
 Trap(interruptVector);
END SizeWindow;

PROCEDURE CloseWindow;
VAR win : WindowPtr;
BEGIN
 win := tdos^.firstWindow;
 IF (win # NIL) THEN
  AX := 020CH;
  Trap(interruptVector);
  DEALLOCATE(win^.buffer,win^.bufferSize);
  DEALLOCATE(win,SIZE(Window));
 END (* IF *);
END CloseWindow;

PROCEDURE CenterText(y    : CARDINAL;
                     text : ARRAY OF CHAR);
VAR adr : ADDRESS;
BEGIN
 Assign(text,tdos^.help);
 adr := ADR(tdos^.help);
 AX := 020DH;
 BX := y;
 ES := adr.SEG;
 DI := adr.OFS;
 XTrap(interruptVector);
END CenterText;

PROCEDURE DrawX(farbe,x,y,l,zeichen : CARDINAL);
BEGIN
 AX := 0006H;
 BX := farbe;
 CX := x;
 DX := y;
 DS := l;
 SI := zeichen;
 XTrap(interruptVector);
END DrawX;

PROCEDURE DrawY(farbe,x,y,l,zeichen : CARDINAL);
BEGIN
 AX := 0007H;
 BX := farbe;
 CX := x;
 DX := y;
 DS := l;
 SI := zeichen;
 XTrap(interruptVector);
END DrawY;

PROCEDURE ModifyProp(gad     : GadgetPtr;
                     pos,max : CARDINAL);
BEGIN
 AX := 020FH;
 BX := pos;
 CX := max;
 ES := gad.SEG;
 DI := gad.OFS;
 XTrap(interruptVector);
END ModifyProp;

PROCEDURE LineH(x,y,l : CARDINAL);
BEGIN
 AX := 0210H;
 BX := x;
 CX := y;
 DX := l;
 Trap(interruptVector);
END LineH;

PROCEDURE LineV(x,y,l : CARDINAL);
BEGIN
 AX := 0211H;
 BX := x;
 CX := y;
 DX := l;
 Trap(interruptVector);
END LineV;

PROCEDURE Char(x,y,zeichen : CARDINAL);
BEGIN
 AX := 0212H;
 BX := x;
 CX := y;
 DX := zeichen;
 Trap(interruptVector);
END Char;

PROCEDURE Box(x,y,w,h : CARDINAL);
BEGIN
 AX := 0213H;
 BX := x;
 CX := y;
 DX := w;
 ES := h;
 XTrap(interruptVector);
END Box;

PROCEDURE ExecuteApplication(name : ARRAY OF CHAR;
                             args : ARRAY OF CHAR;
                             dos  : BOOLEAN) : CARDINAL;
VAR win  : WindowPtr;
    cp,a : CARDINAL;
BEGIN
 IF (dos=TRUE) THEN
  AX := 0300H;
  Trap(interruptVector);
 END (* IF *);

 win := tdos^.firstWindow;
 cp  := tdos^.cursorPos;

 tdos^.firstWindow := NIL;
 tdos^.cursorPos  := 05050H;
 Execute(name,args,a);
 tdos^.firstWindow := win;
 tdos^.cursorPos   := cp;

 IF (dos=TRUE) THEN
  WriteLn;
  WriteString("Drcken Sie eine beliebige Taste, um zu TurboDOS zurckzukehren.");
  AX := 0;
  Trap(016H);
  AX := 0301H;
  Trap(interruptVector);
 END (* IF *);
 RestoreCursor;
 RETURN(a);
END ExecuteApplication;

PROCEDURE CheckTDOS;
VAR seg,ofs,ok : CARDINAL;
BEGIN
 seg := tdos.SEG;
 ofs := tdos.OFS;
 ok  := 0;
 ASM
  MOV ES,seg
  MOV DI,ofs
  MOV AL,ES:[DI]
  MOV BL,ES:[DI+1]
  MOV CL,ES:[DI+2]
  MOV DL,ES:[DI+3]
  CMP AL,"T"
  JNE Nein
  MOV ok,1
 Nein:
 END;
 IF (ok=0) THEN tdos := NIL; END;
END CheckTDOS;

BEGIN
 GetVector(memoryVector,tdos);
 CheckTDOS;

END TurboSys.